Loadstar 94/094.d81/unidir source

Text File | 2022-08-26 | 7KB | 738 lines

open =$ffc0
stop = $ffe1
readst =$ffb7
setlfs =$ffba
setnam =$ffbd
load =$ffd5
getin =$ffe4
clrchn =$ffcc
close =$ffc3   ;a
chrin =$ffcf
chkout =$ffc9  ;x
chkin =$ffc6   ;x
plot =$fff0
chrout =$ffd2
color'pointer =243
screen'line'pointer =209
print'number =$bdcd ;x,a
clear'line =59903
background =53281
border =53280
unlisten =$ffae
clall =$ffe7
strout =$ab1e

.org $c000
.mem
.obj "@0:unidir c000"
lda #0
sta printer
sta 53281
sta 53280
sta del
sta cmd
sta count
sta blocks
sta blocks+1
lda #2
jsr close
lda #15
jsr close
jsr get'number
sty device
sta printer
jsr get'number
sty del
lda #1
ldx <iname
ldy >iname
jsr setnam
lda #15
ldx device
ldy #15
jsr setlfs
jsr open
jsr clrchn

check'cmd ldx #15
jsr chkout
ldy #0
- lda make'error,y
jsr chrout
iny
cpy #4
bne -

jsr clrchn
ldx #15
jsr chkin
ldy #0
- jsr getin
sta buffer,y
iny
cmp #13
bne -

lda buffer
cmp buffer+1
bne +
cmp "7"
bne +

lda #1
sta cmd

+ ldx #15
jsr chkout
lda "i"
jsr chrout
lda #13
jsr chrout

jsr clrchn
lda #2
ldx <name
ldy >name
jsr setnam
lda #2
ldx device
ldy #2
jsr setlfs
jsr open

lda printer
beq begin
lda #4
jsr close
lda #0
tay
tax
jsr setnam
lda #4
ldx #4
ldy #7
jsr setlfs
jsr open

begin jsr fill'buffer
lda #13
sta 646
lda buffer+2
sta drive'type
cmp #65
bne +
lda <floppy
ldy >floppy
jsr strout
lda buffer+3
cmp #128
bne print'single
lda <double
ldy >double
jsr strout
jmp get'header

print'single lda <single
ldy >single
jsr strout
jmp get'header

+ cmp #68
bne +
lda <threed
ldy >threed
jsr strout
jmp get'header

+ cmp #72
bne +
lda <hdname
ldy >hdname
jsr strout
lda #0
ldy #34
- ora buffer,y
iny
cpy #39
bne -
cmp #0
beq print'root

lda <subdir
ldy >subdir
jsr strout
jmp get'header

print'root lda <root
ldy >root
jsr strout
jmp get'header

+ lda <unknown
ldy >unknown
jsr strout

get'header lda #13
jsr chrout
lda drive'type
cmp "h"
beq +

lda cmd
beq +

lda <mode
ldy >mode
jsr strout

+ lda #13
sta 646
lda buffer+2
cmp #65
bne +
ldy #144
bne over

+ ldy #4

over lda #1
sta 199
lda #34
jsr chrout
ldx #0
- lda buffer,y
jsr chrout
iny
inx
cpx #16
bne -

lda #34
jsr chrout
- lda buffer,y
beq +
jsr chrout
iny
bne -

+ ldy #9
lda " "
- jsr chrout
dey
bpl -

lda #13
jsr chrout

lda <explain
ldy >explain
jsr strout

get'file'entries jsr fill'buffer
lda #1
sta 646
lda #0
sta count
lda <buffer+2
sta 251
lda >buffer+2
sta 252

get'blocks jsr stop
bne +
jmp quit
 + lda del
bne +
ldy #0
lda (251),y
bne +
jmp next'file

+  lda #14
sta 646
lda <line
ldy >line
jsr strout
lda #1
sta 646
ldy #1
lda (251),y
bne +

jmp quit

+ ldy #28
lda (251),y
sta temp'blocks
tax
iny
lda (251),y
sta temp'blocks+1
jsr $bdcd
sty temp

ldy #0
lda (251),y
beq +

lda temp'blocks
clc
adc blocks
sta blocks
lda temp'blocks+1
adc blocks+1
sta blocks+1

+ ldy temp
lda #6
sta cols
jsr tab

get'track ldy #1
lda (251),y
tax
lda #0
jsr $bdcd

lda #3
sta cols
jsr tab

get'sector ldy #2
lda (251),y
tax
lda #0
jsr $bdcd

lda #3
sta cols
jsr tab

get'filename lda #34
jsr chrout
ldy #3
- lda (251),y
ldx #1
sta 212
cmp " "
bne +
lda " "
+ jsr chrout
iny
cpy #19
bne -
lda #0
sta 212

lda #34
jsr chrout

ldy #2
lda " "
- jsr chrout
dey
bpl -


get'type ldy #0
lda (251),y
sta temp
and #127
and #191
and #159
cmp #7
bcc +
lda #7
+ sta type
asl
clc
adc type

tay
ldx #0
- lda types,y
jsr chrout
iny
inx
cpx #3
bne -

lda type
beq +
lda temp
bmi +

lda "*"
jsr chrout

+ lda temp
cmp #192
bcc +
lda "<"
jsr chrout

+ lda #13
jsr chrout

get'date lda #3
sta 646
lda #0
sta emulation
ldy #23
- ora (251),y
iny
cpy #26
bne -
cmp #0
bne +
jmp check'rel

+ sta emulation
lda #14
sta cols
ldy #0
jsr tab
lda <creation
ldy >creation
jsr strout

ldy #24
lda (251),y
tax
cmp #10
bcs +
lda "0"
jsr chrout
+ lda #0
jsr $bdcd
lda "/"
jsr chrout
ldy #25
lda (251),y
tax
cmp #10
bcs +
lda "0"
jsr chrout
+ lda #0
jsr $bdcd
lda "/"
jsr chrout
ldy #23
lda (251),y
tax
cmp #10
bcs +
lda "0"
jsr chrout
+ lda #0
jsr $bdcd
lda " "
jsr chrout

lda #0
sta temp
ldy #26
lda (251),y
cmp #13
bcc +
sta temp
sec
sbc #12

+ tax
cmp #10
bcs +
lda "0"
jsr chrout
+ lda #0
jsr $bdcd
lda ":"
jsr chrout
ldy #27
lda (251),y
tax
cmp #10
bcs +
lda "0"
jsr chrout

+ lda #0
jsr $bdcd
lda "a"
ldx temp
beq +
lda "p"
+ jsr chrout
lda #13
jsr chrout

check'rel lda #7
sta 646
lda type
cmp #4
beq +
jmp check'replace

+ ldy #0
lda #6
sta cols
jsr tab

get'rtrack ldy #19
lda (251),y
tax
lda #0
jsr $bdcd

lda #3
sta cols
jsr tab

get'rsector ldy #20
lda (251),y
tax
lda #0
jsr $bdcd

lda #3
sta cols
jsr tab

lda <side'sector
ldy >side'sector
jsr strout

ldy #0
lda #6
sta cols
jsr tab

get'rec'length ldy #21
lda (251),y
tax
lda #0
jsr $bdcd

lda #7
sta cols
jsr tab

lda <length
ldy >length
jsr strout
jmp next'file

check'replace lda #10
sta 646
lda emulation
bne next'file
lda drive'type
cmp "h"
bne +
jmp next'file

+ ldy #26
lda (251),y
bne +
jmp next'file

+ ldy #0
lda #6
sta cols
jsr tab

get'srtrack ldy #26
lda (251),y
tax
lda #0
jsr $bdcd

lda #3
sta cols
jsr tab

get'srsector ldy #27
lda (251),y
tax
lda #0
jsr $bdcd

lda #3
sta cols
jsr tab

lda <replaced
ldy >replaced
jsr strout


next'file lda 653
bne next'file
inc count
lda count
cmp #8
beq +

lda #32
clc
adc 251
sta 251
lda #0
adc 252
sta 252
jmp get'blocks

+ lda eof
bne quit
jmp get'file'entries

quit lda #1
sta 646
lda #2
jsr close
lda #15
jsr close
jsr clrchn

lda #15
ldx <block'name
ldy >block'name
jsr setnam
lda #2
ldx device
ldy #0
jsr setlfs
jsr open
jsr clrchn
ldx #2
jsr chkin

ldy #33
- jsr getin
dey
bpl -

jsr getin
sta temp
jsr getin
sta temp+1

lda printer
beq +
jsr clrchn
ldx #4
jsr chkout

+ lda #13
jsr chrout
ldx temp
lda temp+1
jsr $bdcd

lda <free
ldy >free
jsr strout

lda #13
jsr chrout
ldx blocks
lda blocks+1
jsr $bdcd

lda <used
ldy >used
jsr strout
jsr clrchn

lda #4
jsr close
lda #2
jsr close
rts

fill'buffer jsr clrchn
ldx #2
jsr chkin

ldy #0
- jsr getin
sta buffer+2,y
iny
cpy #254
bne -
jsr readst
and #64
sta eof
jsr clrchn
lda printer
beq +
ldx #4
jsr chkout
+ rts

;**** get number from BASIC ****

get'number jsr $aefd
jsr $ad8a
jsr $b7f7
rts

;***** get string from BASIC ****

get'string jsr $aefd
jsr $ad9e
jsr $b6a3

ldx $22
ldy $23
rts

tab sty temp; length of number string
lda cols
sec
sbc temp
tay
lda " "
- jsr chrout
dey
bpl -
rts

name .asc "$:"
device .byt 0
;buffer .buf 256
floppy .asc "1541/71 disk":.byt 0
single .asc " 1-sided (664 blocks)":.byt 0
double .asc " 2-sided (1328 blocks)":.byt 0
threed .asc "1581 disk (3160 blocks)":.byt 0
hdname .asc "cmd native partition":.byt 0
root .asc " (root)":.byt 0
unknown .asc "unknown":.byt 0
subdir .asc " (subdirectory)":.byt 0
mode .asc "cmd emulation mode partition":.byt 13,0
explain .asc "blocks trk sec filename            type":.byt 13,0
line    .asc "---------------------------------------":.byt 13,0
creation .asc "created: ":.byt 0
side'sector .asc "<-- side sector t/s":.byt 13,0
length .asc "<-- record length":.byt 13,0
replaced .asc "<-- botched save/open@":.byt 13,0
iname .asc "i"
block'name .asc "$:JeFfBeGo0d!\'"
free .asc "  blocks free.":.byt 13,0
used .asc "  blocks allocated by files.":.byt 13,0
blocks .word 0
drive'type .byt 0
count .byt 0
types .asc "delseqprgusrrelcbmdir???"
temp .byt 0
cols .byt 0
type .byt 0
emulation .byt 0
printer .byt 0
eof .byt 0
make'error .asc "cp0":.byt 13
cmd .byt 0
del .byt 0
temp'blocks .buf 2
buffer =*